home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / PATHFIND.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  21.8 KB  |  730 lines
  1. 10  'PATHFIND - Combined GRCIRCL & LATLONG programs - 02 APR 92 rev. 28 JAN 97
  2. 20  COMMON EX$,PROG$
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  PROG$="pathfind"
  5. 50  GO$="latlong"
  6. 60  IF LIB=1 THEN 380   'LIB = data already loaded flag
  7. 70  IF POSN THEN 380
  8. 80  LIB=1
  9. 90  ON ERROR GOTO 210
  10. 100  CLS:KEY OFF
  11. 110  COLOR 7,0,1
  12. 120  DIM A$(1024,4),F$(50,2)
  13. 130  U1$="#####.#":U2$="##,###.#":U3$="####.#":U4$="####,###.#":U5$="###.#"
  14. 140  UL$=STRING$(80,205)
  15. 150  XX$=STRING$(79,32)          'blank
  16. 160  E$=CHR$(248)                '<UNK! {00F8}> symbol
  17. 170  PI=3.14159
  18. 180  IF BASEONLY=1 THEN GOSUB 250:GOTO 4020     'run database only
  19. 190  GOSUB 260:GOTO 380
  20. 200  '
  21. 210  '.....error trap
  22. 220  PRINT "Error";ERR;"in line";ERL;"...Press any key to start over..."
  23. 230  IF INKEY$=""THEN 230
  24. 240  RUN EX$
  25. 250  '
  26. 260  '.....load data
  27. 270  PRINT " LOADING DATA from DISK - Please stand by......"
  28. 280  OPEN "I",1,"\data\latlong\LATLONG.DAT"
  29. 290  IF EOF(1) THEN 350
  30. 300  N=N+1
  31. 310  FOR Y=1 TO 4
  32. 320  INPUT# 1,A$(N,Y)
  33. 330  NEXT Y
  34. 340  GOTO 290
  35. 350  CLOSE
  36. 360  RETURN
  37. 370  '
  38. 380  '.....start
  39. 390  CLS
  40. 400  IF LATLONG=1 THEN LATLONG=0:GOTO 4020   'latlong program
  41. 410  COLOR 15,2
  42. 420  PRINT " GREAT CIRCLE PATHS, BEARINGS and DISTANCES";
  43. 430  PRINT TAB(57);"by George Murphy VE3ERP ";
  44. 440  COLOR 1,0:PRINT STRING$(80,223);
  45. 450  COLOR 7,0
  46. 460  IF POSN THEN Z=POSN:GOSUB 1250:GOTO 950
  47. 470  '
  48. 480  GOSUB 6960  'preface
  49. 490  PRINT UL$;
  50. 500  PRINT " Press number in < > to:"
  51. 510  PRINT UL$;
  52. 520  PRINT "  < 1 >  RUN program"
  53. 530  PRINT "  < 2 >  VIEW/EDIT/SEARCH data files (Latitude/Longitude Data Base)"
  54. 540  PRINT UL$;
  55. 550  PRINT "  < 0 >  EXIT"
  56. 560  Z$=INKEY$
  57. 570  IF Z$="0"THEN CLS:RUN EX$
  58. 580  IF Z$="1"THEN GOSUB 620:GOTO 740
  59. 590  IF Z$="2"THEN CLS:CHAIN"latlong"
  60. 600  GOTO 560
  61. 610  '
  62. 620  '....units of distance
  63. 630  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  64. 640  PRINT " Press letter in < > to select units of distance:"
  65. 650  PRINT UL$;
  66. 660  PRINT "  < n >  Nautical miles"
  67. 670  PRINT "  < s >  Statute miles"
  68. 680  PRINT "  < k >  Kilometers"
  69. 690  Z$=INKEY$
  70. 700  IF Z$="n"OR Z$="s"OR Z$="k"THEN FAR$=Z$:GOTO 720
  71. 710  GOTO 690
  72. 720  RETURN
  73. 730  '
  74. 740  '.....instructions
  75. 750  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3,2
  76. 760  COLOR 0,7:PRINT " NOTE: ":COLOR 7,0
  77. 770  PRINT
  78. 780  PRINT "  Enter latitude and longitude as decimal degrees, to the nearest ";
  79. 790  PRINT "1/10th of a"
  80. 800  PRINT "  degree, e.g. 47.3 for 48<UNK! {00F8}>20'. If you enter data with more than ";
  81. 810  PRINT "one place of"
  82. 820  PRINT "  decimals the data entered will be used in all calculations, even ";
  83. 830  PRINT "though all"
  84. 840  PRINT "  data displayed will be rounded-off to the nearest 1/10th degree."
  85. 850  PRINT
  86. 860  PRINT "  1/10th of a degree longitude is equal to about 11 kilometers ";
  87. 870  PRINT "at the equator,"
  88. 880  PRINT "  less than 6 Km. at 60<UNK! {00F8}> latitude."
  89. 890  PRINT
  90. 900  PRINT UL$;
  91. 910  '
  92. 920  '.....inputs
  93. 930  P$(1)="A ":P$(2)="B "
  94. 940  '
  95. 950  LOCATE 15
  96. 960  IF POSN THEN ZZ=POSN ELSE ZZ=1
  97. 970  IF POSN<>1 THEN 1030
  98. 980  GOSUB 1230
  99. 990  IF Z=1 THEN PRINT "Point A:"
  100. 1000  PRINT "Latitude of  ";P$(Z);USING U2$;ABS(LA(Z));:PRINT NS$(Z)
  101. 1010  PRINT "Longitude of ";P$(Z);USING U2$;ABS(LO(Z));:PRINT EW$(Z)
  102. 1020  '
  103. 1030     FOR Z=ZZ TO 2   '********** start input loop **********
  104. 1040  DOT$=STRING$(39-LEN(P$(Z)),".")
  105. 1050  IF POSN=Z THEN GOSUB 1230:GOTO 1290
  106. 1060  IF(P$(Z)<>"" AND LA(Z)*LO(Z))THEN 1290
  107. 1070  COLOR 0,7:LOCATE CSRLIN,7
  108. 1080  PRINT" (ENTER <x> to access data on file or enter latitude:";
  109. 1090  COLOR 7,0
  110. 1100  PRINT" ENTER: Latitude (minus if South) of ";P$(Z);:INPUT I$
  111. 1110  IF I$="x"OR I$="X"THEN POSN=Z:CLS:GOTO 4020       'latlong program
  112. 1120  LA(Z)=VAL(I$):GOSUB 1230
  113. 1130  FOR CL=CSRLIN-2 TO CSRLIN:LOCATE CL:PRINT XX$:NEXT CL
  114. 1140  LOCATE CSRLIN-3,8
  115. 1150  PRINT " Latitude of  ";P$(Z);DOT$;USING U2$;ABS(LA(Z));:PRINT NS$(Z)
  116. 1160  PRINT" ENTER: Longitude (minus if West) of ";P$(Z);:INPUT LO(Z)
  117. 1170  GOSUB 1230
  118. 1180  FOR CL=CSRLIN-1 TO CSRLIN:LOCATE CL:PRINT XX$:NEXT CL
  119. 1190  LOCATE CSRLIN-2,8
  120. 1200  PRINT " Longitude of ";P$(Z);DOT$;USING U2$;ABS(LO(Z));:PRINT EW$(Z)
  121. 1210  GOTO 1290
  122. 1220  '
  123. 1230  IF SGN(LA(Z))=-1 THEN NS$(Z)=E$+"S "ELSE NS$(Z)=E$+"N "
  124. 1240  IF SGN(LO(Z))=-1 THEN EW$(Z)=E$+"W "ELSE EW$(Z)=E$+"E "
  125. 1250  RLA(Z)=LA(Z)*PI/180      'latitude in radians
  126. 1260  RLO(Z)=LO(Z)*PI/180      'longitude in radians
  127. 1270  RETURN
  128. 1280  '
  129. 1290  IF MID$(P$(Z),2)=" "THEN 1300 ELSE 1450
  130. 1300  PRINT " Do you want to name ";P$(Z);"?  (y/n)"
  131. 1310  Z$=INKEY$
  132. 1320  IF Z$="n"OR Z$="N"THEN LOCATE CSRLIN-1:PRINT XX$:LOCATE CSRLIN-1:GOTO 1450
  133. 1330  IF Z$="y"OR Z$="Y"THEN 1360
  134. 1340  GOTO 1310
  135. 1350  '
  136. 1360   LOCATE CSRLIN-1:PRINT XX$:LOCATE CSRLIN-1
  137. 1370   PRINT " ENTER: Name of ";P$(Z);" ? ";:LINE INPUT P$(Z)
  138. 1380    FOR X=1 TO LEN(P$(Z))
  139. 1390     V=ASC(MID$(P$(Z),X)):IF V<97 OR V>122 THEN 1410
  140. 1400     MID$(P$(Z),X)=CHR$(V-32)
  141. 1410    NEXT X
  142. 1420   X=0:LOCATE CSRLIN-1:PRINT XX$
  143. 1430  FOR CL=CSRLIN-3 TO CSRLIN-2:LOCATE CL,22:PRINT P$(Z):NEXT CL
  144. 1440  '
  145. 1450     NEXT Z    '********** end input loop **********
  146. 1460  '
  147. 1470  ROUTE=SGN(LA(1)+LA(2))                   'determine north or south route
  148. 1480  IF LA(1)<0 AND LA(2)<0 THEN ROUTE=1      'A & B both in southern hemisphere
  149. 1490  '
  150. 1500  '.....display initial Pathfind data
  151. 1510  VIEW PRINT 3 TO 23:CLS:VIEW PRINT        'erase screen
  152. 1520  LOCATE 3
  153. 1530  Z=1:GOSUB 1230
  154. 1540  PRINT TAB(8);"Path between";
  155. 1550  DOT$=STRING$(39-LEN(P$(1)),".")
  156. 1560  PRINT TAB(21);P$(1);" ";DOT$;
  157. 1570  PRINT TAB(61);USING U1$;ABS(LA(1));
  158. 1580  PRINT NS$(1);USING U1$;ABS(LO(1));
  159. 1590  PRINT EW$(1);
  160. 1600  LOCATE CSRLIN-1,44:PRINT " Solar zone UTC";USING "+##";LO(1)/15;
  161. 1610  Z=2:GOSUB 1230
  162. 1620  PRINT TAB(13);"    and";
  163. 1630  DOT$=STRING$(39-LEN(P$(2)),".")
  164. 1640  PRINT TAB(21);P$(2);" ";DOT$;
  165. 1650  PRINT TAB(61);USING U1$;ABS(LA(2));
  166. 1660  PRINT NS$(2);USING U1$;ABS(LO(2));
  167. 1670  PRINT EW$(2);
  168. 1680  LOCATE CSRLIN-1,44:PRINT " Solar zone UTC";USING "+##";LO(2)/15;
  169. 1690  GOSUB 1790                                'to make B > A
  170. 1700   MERID=0                                  'default value
  171. 1710   IF LO(1)=LO(2)THEN MERID=1:GOTO 1760     'A & B on same meridian
  172. 1720  IF ABS(LO(1))+ABS(LO(2))<>180 THEN 1760
  173. 1730   LA(2)=180-LA(2):MERID=1                  'A & B on opposite meridians
  174. 1740   IF LA(2)>180 THEN LA(2)=LA(2)-90
  175. 1750   RLA(2)=LA(2)*PI/180                      'angle in radians
  176. 1760  GOSUB 3350                                'calculation sub-routine
  177. 1770  GOTO 1890                                 'screen print
  178. 1780  '
  179. 1790  '.....point B must be place of greater latitude
  180. 1800  ALA=RLA(1):BLA=RLA(2)
  181. 1810  IF(ALA=BLA)AND(RLO(1)>RLO(2))THEN 1840              'both on equator
  182. 1820  IF (ALA<0)AND(BLA<0)THEN ALA=ABS(ALA):BLA=ABS(BLA)  'both south of equator
  183. 1830  IF BLA>ALA THEN 1870
  184. 1840  SWAP RLA(1),RLA(2)
  185. 1850  SWAP RLO(1),RLO(2)
  186. 1860  SWAP P$(1),P$(2)
  187. 1870  RETURN
  188. 1880  '
  189. 1890  '.....display balance of Pathfind data
  190. 1900  LONDIFF=ABS(LO(1)-LO(2))                  'difference in longitude
  191. 1910  IF LONDIFF >180 THEN LONDIFF=360-LONDIFF
  192. 1920  HR=LONDIFF
  193. 1930  ZONE=LONDIFF/15                           'no. of 1 hr.time zones
  194. 1940  HR=ZONE
  195. 1950  T=21
  196. 1960  IF FAR$=""THEN FAR$="n"                   'default
  197. 1970  IF FAR$="n"THEN DIST=ZD*60:DIST$=" Naut.Miles":GOTO 2000
  198. 1980  IF FAR$="s"THEN DIST=ZD*24856.8/360:DIST$=" Stat.Miles":GOTO 2000
  199. 1990  IF FAR$="k"THEN DIST=ZD*40000/360:DIST$=" Kilometers"
  200. 2000   PRINT TAB(T);"Great Circle distance (";DIST$;" )";STRING$(4,".");" ";
  201. 2010   PRINT USING U2$;DIST;
  202. 2020   PRINT TAB(T);"Solar Time difference";STRING$(19,".");
  203. 2030   PRINT USING "#######.##";HR;:PRINT " hrs."
  204. 2040    D1$=STRING$(27-LEN(P$(1)),".")
  205. 2050   PRINT TAB(T);"Bearing from ";P$(1);D1$;TAB(64);USING U3$;XD;
  206. 2060   PRINT CHR$(248)
  207. 2070    D2$=STRING$(27-LEN(P$(2)),46)
  208. 2080   PRINT TAB(T);"Bearing from ";P$(2);D2$;TAB(64);USING U3$;YD;
  209. 2090   PRINT CHR$(248)
  210. 2100  '
  211. 2110  '.....intermediate plots
  212. 2120  IF MERID<>1 THEN 2140
  213. 2130  IF LO(1)<>LO(2)THEN LB=PI-LB
  214. 2140  IF RLO(1)<0 THEN RLO(1)=2*PI+RLO(1)
  215. 2150  IF RLO(2)<0 THEN RLO(2)=2*PI+RLO(2)
  216. 2160  COLOR 1,0:PRINT STRING$(80,223);
  217. 2170  COLOR 0,7
  218. 2180  LOCATE CSRLIN-1,21:PRINT "  I N T E R M E D I A T E    P L O T S  "
  219. 2190  COLOR 7,0
  220. 2200  PRINT " To ";P$(1);
  221. 2210  T=80-3-LEN(P$(2))
  222. 2220  PRINT TAB(T);"To ";P$(2);
  223. 2230  PRINT "  CLSSOUNDDEFSNG";TAB(6);DIST$;
  224. 2240  PRINT TAB(18);"DEFSNGSOUND Bearing";
  225. 2250  PRINT TAB(29);"DEFSNGSOUND VARPTRSOUNDSOUND From Plot SOUNDSOUNDCOLOR SOUNDDEFDBL";
  226. 2260  PRINT TAB(53);"Bearing SOUNDDEFDBL";
  227. 2270  PRINT TAB(63);DIST$;TAB(76);"DEFDBLSOUND'"
  228. 2280  PRINT UL$;
  229. 2290  '
  230. 2300  '.....loop for intermediate plots
  231. 2310  NP=11                                      'no. of plots
  232. 2320  IF ZR<PI/200 THEN 3200                     'A & B closer than 100 Km apart
  233. 2330  D=NP+1                                     'no.of segments
  234. 2340  DS=(ZR/D)                                  'interval distance angle
  235. 2350  HOLD=N                                     'hold N=no. of locations on file
  236. 2360  FIRST=RLO(1)                               'longitude of start plot
  237. 2370  '
  238. 2380  FOR N=NP TO 1 STEP-1 '******************START LOOP********************
  239. 2390  '
  240. 2400  '.....find latitude of plot
  241. 2410  REM                                         LA=latitude of FIRST
  242. 2420  REM                                         X=bearing FIRST
  243. 2430  DA=DS*N                                    'segment distance angle
  244. 2440  SEG=N/D*DIST                               'segment distance
  245. 2450  IF ROUTE<>0 THEN DA=DA*ROUTE               'route can be north or south
  246. 2460  IF EQUAT THEN LAP=PI/2:PLAP=PI/2:PLA=0:GOTO 2540
  247. 2470  IF MERID THEN PLA=LA+DA:GOTO 2570
  248. 2480  LAP=PI/2-LA                                'angle between LA & pole
  249. 2490  A=COS(LAP)*COS(DA)+SIN(LAP)*SIN(DA)*COS(X) 'law of cosines for sides
  250. 2500  ANGL=ATN(A/SQR(-A*A+1))                    'angle between plot & pole
  251. 2510  PLAP=ABS(ANGL-PI/2)
  252. 2520  PLA=PI/2-PLAP                              'latitude of plot
  253. 2530  '
  254. 2540  '.....find longitude of plot
  255. 2550  B=(COS(DA)-COS(PLAP)*COS(LAP))/SIN(PLAP)/SIN(LAP) 'law of cosines for sides
  256. 2560  NOTE=0:IF ABS(B)>=1 THEN B=1:BEEP:NOTE=1   'round-off inaccuracy
  257. 2570  IF MERID THEN PLO=FIRST:PLOD=0:GOTO 2700
  258. 2580  PLOD=ATN(B/SQR(-B*B+1))+PI/2               'difference in longitude
  259. 2590  '
  260. 2600  IF PLOD<PI/2 THEN PLOD=PI/2-PLOD+PI/2:GOTO 2630
  261. 2610  IF PLOD>PI/2 THEN PLOD=PI-PLOD
  262. 2620  '
  263. 2630  IF RLO(2)-FIRST>PI THEN RLO(2)=RLO(2)-2*PI 'path crossing 0<UNK! {00F8}> meridian
  264. 2640  IF FIRST-RLO(2)>PI THEN RLO(2)=RLO(2)+2*PI
  265. 2650  IF FIRST<RLO(2)THEN PLO=FIRST+PLOD
  266. 2660  IF FIRST>RLO(2)THEN PLO=FIRST-PLOD
  267. 2670  IF PLO<0 THEN PLO=PLO+2*PI
  268. 2680  IF PLO>2*PI THEN PLO=PLO-2*PI
  269. 2690  '
  270. 2700  PLAN=PLA
  271. 2710  IF MERID <>1 THEN 2740
  272. 2720    IF PLAN>PI/2 THEN PLAN=PI-PLAN:PLO=PLO+PI
  273. 2730    IF PLAN<-PI/2 THEN PLAN=PI+PLAN:PLO=PLO+PI
  274. 2740  PLON=PLO                                   'location for printout
  275. 2750  IF PLON>PI THEN PLON=2*PI-PLON
  276. 2760  RLA(2)=PLA:RLO(2)=PLO                      'new start point
  277. 2770  GOSUB 3350     'calculate bearings
  278. 2780  '
  279. 2790  '.....display plot headings & distance
  280. 2800  REM                                         Y=bearing to P$(1)
  281. 2810  YR=Y+PI                                    'reciprocal heading to P$(2)
  282. 2820  IF YR>2*PI THEN YR=YR-2*PI
  283. 2830  IF FAR$="n"THEN D1=NM:D2=DIST-D1           'distance - nautical miles
  284. 2840  IF FAR$="s"THEN D1=SM:D2=DIST-D1           'distance - nautical miles
  285. 2850  IF FAR$="k"THEN D1=KM:D2=DIST-D1           'distance - nautical miles
  286. 2860  '
  287. 2870  '.....display plots
  288. 2880  N$=STR$(NP-N+1):IF LEN(N$)=2 THEN N$=" "+N$
  289. 2890  N$=RIGHT$(N$,2)
  290. 2900  E$=CHR$(248)                                           '<UNK! {00F8}> degree symbol
  291. 2910  '
  292. 2920  PRINT " ";N$;                                          'plot no.
  293. 2930  PRINT TAB(7);                                          'set margin
  294. 2940  PRINT USING U4$;ABS(SEG);:PRINT "  ";                  'distance
  295. 2950  E$=CHR$(248)                                           '<UNK! {00F8}> degree symbol
  296. 2960  PRINT USING U1$;Y*180/PI;:PRINT E$;                    'bearing
  297. 2970  PRINT "  DEFSNGSOUND";                                          'left arrow
  298. 2980  IF PLAN<0 THEN NS$=E$+"S"ELSE NS$=E$+"N"
  299. 2990  COLOR 0,7
  300. 3000  PRINT USING U3$;ABS(PLAN*180/PI);:PRINT NS$;           'latitude
  301. 3010  IF PLO>PI AND PLO<2*PI THEN EW$=E$+"W"ELSE EW$=E$+"E"
  302. 3020  PRINT USING U1$;ABS(PLON)*180/PI;:PRINT EW$;"  ";      'longitude
  303. 3030  COLOR 7,0
  304. 3040  PRINT "SOUNDDEFDBL";                                            'right arrow
  305. 3050  RY=YR*180/PI:IF CINT(RY)=360 THEN RY=0
  306. 3060  PRINT USING U1$;RY;:PRINT E$;"  ";                     'bearing
  307. 3070  PRINT USING U4$;ABS(DIST-SEG);:PRINT " ";              'distance
  308. 3080  IF N=3 OR N=9 THEN COLOR 0,7:PRINT "1/4 way";
  309. 3090  IF N=4 OR N=8 THEN COLOR 0,7:PRINT "1/3 way";
  310. 3100  IF N=6 THEN COLOR 0,7:PRINT "1/2 way";
  311. 3110  COLOR 7,0
  312. 3120  PRINT ""                                               'end of line
  313. 3130  '
  314. 3140     NEXT N         '******************END LOOP*********************
  315. 3150  IF NOTE THEN 3170
  316. 3160  PRINT UL$;
  317. 3170  N=HOLD                   'N=no. of locations on file
  318. 3180  GOTO 3260
  319. 3190  '
  320. 3200  '.....A & B very close together
  321. 3210  COLOR 14,12
  322. 3220  PRINT "     Intermediate plots are redundant for locations less than 100 ";
  323. 3230  PRINT "km. apart"
  324. 3240  COLOR 7,0
  325. 3250  '
  326. 3260  IF NOTE=0 THEN 3310
  327. 3270  COLOR 14,12
  328. 3280  PRINT "  SOME PLOT BEARINGS MAY BE INACCURATE DUE TO CALCULATION ";
  329. 3290  PRINT "ROUNDING-OFF ERRORS";
  330. 3300  COLOR 7,0
  331. 3310  GOSUB 7170:GOTO 6880                     'screen dump/exit option
  332. 3320  '
  333. 3330  '**********SUB-ROUTINES**********
  334. 3340  '
  335. 3350  '.....calculate bearings and distance
  336. 3360  REM RLA(n) & RLO(n) are LAT & LONG inputs in radians
  337. 3370  LB=RLA(2)                               'latitude of point B in radians
  338. 3380  LA=RLA(1)                               'latitude of point A in radians
  339. 3390  IF LA=0 AND LB=0 THEN 3580              'both points on equator
  340. 3400  C=RLO(1)-RLO(2)                         'difference in longitude
  341. 3410  IF C=0 THEN 3450                        'both points on same meridian
  342. 3420  IF ABS(C)=PI THEN 3510                  'points on opposite meridian
  343. 3430  GOTO 3670
  344. 3440  '
  345. 3450  '.....A & B both on same meridian
  346. 3460  ZR=LB-LA:ZD=ZR*180/PI
  347. 3470  Y=PI:YD=180
  348. 3480  X=0:XD=0
  349. 3490  RETURN
  350. 3500  '
  351. 3510  '.....A & B on opposite meridians
  352. 3520  ZR=LB-LA:IF ZR>PI THEN ZR=2*PI-ZR
  353. 3530  IF ZR<PI THEN Y=0:YD=0:X=0:XD=0
  354. 3540  IF ZR>PI THEN Y=PI:YD=180:X=PI:XD=180
  355. 3550  ZD=ZR*180/PI
  356. 3560  RETURN
  357. 3570  '
  358. 3580  '.....A & B both on equator
  359. 3590  EQUAT=1                                 'flag
  360. 3600  Y=PI/2:YD=Y*180/PI
  361. 3610  X=1.5*PI:XD=X*180/PI
  362. 3620  L=ABS(RLO(1)-RLO(2))
  363. 3630  IF L>PI THEN L=2*PI-L
  364. 3640  ZR=L:ZD=ZR*180/PI
  365. 3650  GOTO 3830
  366. 3660  '
  367. 3670  '.....formula elements
  368. 3680  F0=1/TAN(C/2)                           'cotangent C/2
  369. 3690  F1=F0*SIN((LB-LA)/2)/COS((LB+LA)/2)
  370. 3700  IF LB+LA=0 THEN F2=F0*COS((LB-LA)/2)/SIN(9.8E-08):GOTO 3720
  371. 3710  F2=F0*COS((LB-LA)/2)/SIN((LB+LA)/2)
  372. 3720  F3=ATN(F1)
  373. 3730  F4=ATN(F2)
  374. 3740  '
  375. 3750  '.....bearings
  376. 3760  Y=F4+F3                                 'bearing at point B
  377. 3770  IF LA<0 AND LB<0 THEN Y=Y+PI:GOTO 3790  'A & B both in southern hemisphere
  378. 3780  IF ABS(LA)>ABS(LB)THEN Y=Y+PI
  379. 3790  IF Y<0 THEN Y=Y+2*PI
  380. 3800  IF Y>=(2*PI)THEN Y=Y-2*PI
  381. 3810  YD=Y*180/PI                             'bearing in degrees at point B
  382. 3820  '
  383. 3830  X=F4-F3                                 'bearing at point A
  384. 3840  IF LA<0 AND LB<0 THEN X=X+PI:GOTO 3860  'A & B both in southern hemisphere
  385. 3850  IF ABS(LA)>ABS(LB)THEN X=X+PI
  386. 3860  IF X<0 THEN X=X+2*PI
  387. 3870  IF X>=(2*PI)THEN X=X-2*PI
  388. 3880  XR=2*PI-X                               'reciprocal
  389. 3890  IF XR<0 THEN XR=XR+2*PI
  390. 3900  IF XR>=(2*PI)THEN XR=XR-2*PI
  391. 3910  XD=XR*180/PI                            'bearing in degrees at point A
  392. 3920  '
  393. 3930  '.....distance
  394. 3940  IF RLO(1)=RLO(2)THEN ZR=ABS(LB-LA):GOTO 3980
  395. 3950  IF LA=LB THEN LB=LB+9.8E-08:GOTO 3400  'avoids trig function of angle 0
  396. 3960  F5=TAN((LB-LA)/2)*SIN(F4)/SIN(F3)       'F5=tan ZR/2 (ZR=distance angle)
  397. 3970  ZR=ABS(2*ATN(F5))                       'distance angle in radians
  398. 3980  ZD=ZR*180/PI                            'distance angle in degrees
  399. 3990  '
  400. 4000  RETURN
  401. 4010  '
  402. 4020  '.....LATLONG - 20 NOV 85 rev. 12 FEB 94
  403. 4030  CLS
  404. 4040  IF FAR$<>""THEN 5330
  405. 4050  COLOR 15,2
  406. 4060  PRINT " LATITUDE & LONGITUDE Data Base";TAB(57);"by George Murphy VE3ERP ";
  407. 4070  COLOR 1,0:PRINT STRING$(80,223);
  408. 4080  COLOR 7,0
  409. 4090  PRINT " Press number in < > to:"
  410. 4100  PRINT UL$;
  411. 4110  PRINT "  < 1 >  ADD a listing"
  412. 4120  PRINT "  < 2 >  FIND or EDIT a listing"
  413. 4130  PRINT "  < 3 >  DISPLAY listings"
  414. 4140  PRINT UL$;
  415. 4150  PRINT "  < 0 >  EXIT"
  416. 4160  Z$=INKEY$
  417. 4170  IF Z$="1"THEN CLS:GOTO 4520
  418. 4180  IF Z$="2"THEN CLS:GOTO 5330
  419. 4190  IF Z$="3"THEN CLS:GOSUB 4660:GOTO 4920
  420. 4200  IF Z$="0"THEN 380
  421. 4210  GOTO 4160
  422. 4220  '
  423. 4230  '.....save data
  424. 4240  PRINT " SAVING DATA to DISK
  425. 4250  OPEN "O",1,"\data\latlong\LATLONG.DAT"
  426. 4260  FOR Z=1 TO N
  427. 4270  WRITE# 1,A$(Z,1),A$(Z,2),A$(Z,3),A$(Z,4)
  428. 4280  NEXT Z
  429. 4290  CLOSE
  430. 4300  GOTO 4030
  431. 4310  '
  432. 4320  '.....change text to capital letters
  433. 4330  FOR U=1 TO LEN(I$)
  434. 4340  V=ASC(MID$(I$,U,1))
  435. 4350  IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
  436. 4360  NEXT U
  437. 4370  RETURN
  438. 4380  '.....inputs
  439. 4390  INPUT " ENTER: City or town...................";I$:GOSUB 4320
  440. 4400  GOSUB 4480:RETURN
  441. 4410  INPUT " ENTER: Province, State or Country.....";I$:GOSUB 4320
  442. 4420  GOSUB 4480:RETURN
  443. 4430  INPUT " ENTER: Latitude (minus if South)......";I$
  444. 4440  GOSUB 4480:RETURN
  445. 4450  INPUT " ENTER: Longitude (minus if West)......";I$
  446. 4460  GOSUB 4480:RETURN
  447. 4470  '
  448. 4480  LOCATE CSRLIN-1:PRINT STRING$(6,32)
  449. 4490  LOCATE CSRLIN-1,39:PRINT "  ";I$;"   "
  450. 4500  RETURN
  451. 4510  '
  452. 4520  '.....new listing
  453. 4530  N=N+1
  454. 4540  PRINT " NEW LISTING"
  455. 4550  PRINT UL$;
  456. 4560  FOR Z=1 TO 4
  457. 4570  ON Z GOSUB 4390,4410,4430,4450
  458. 4580  A$(N,Z)=I$
  459. 4590  NEXT Z
  460. 4600  CLS
  461. 4610  Z=N
  462. 4620  IF LEN(A$(N,1))+LEN(A$(N,2))<21 THEN 6510
  463. 4630  BEEP:PRINT:PRINT " TOO LONG! Please abbreviate one or both names"
  464. 4640  PRINT:GOTO 6510
  465. 4650  '
  466. 4660  '.....compile
  467. 4670  IF A$(1,1)<>""THEN 4760
  468. 4680  FOR Y=1 TO N
  469. 4690  FOR X=1 TO 4
  470. 4700  A$(Y,X)=A$(Y+1,X)
  471. 4710  NEXT X
  472. 4720  NEXT Y
  473. 4730  N=N-1
  474. 4740  GOTO 4670
  475. 4750  '
  476. 4760  '.....sort
  477. 4770  SN=N:SM=SN:PRINT " SORTING at level.....";
  478. 4780  SM=INT(SM/2):IF SM=0 THEN CLS:GOTO 4900
  479. 4790  LOCATE 1,20:PRINT USING "####";SM*2
  480. 4800  SK=SN-SM:SJ=1
  481. 4810  SI=SJ
  482. 4820  SL=SI+SM
  483. 4830  IF A$(SI,1)<=A$(SL,1)THEN 4880
  484. 4840  FOR X=1 TO 4
  485. 4850  SWAP A$(SI,X),A$(SL,X)
  486. 4860  NEXT X
  487. 4870  SI=SI-SM:IF SI>0 THEN 4820
  488. 4880  SJ=SJ+1:IF SJ>SK THEN 4780
  489. 4890  GOTO 4810
  490. 4900  RETURN
  491. 4910  '
  492. 4920  '.....screen display
  493. 4930  CLS
  494. 4940  LIN=0            'line no.
  495. 4950  '
  496. 4960  FOR Z=1 TO N STEP 2
  497. 4970  LIN=LIN+1
  498. 4980  IF LIN=1 THEN LOCATE 1
  499. 4990  GOSUB 5180                              'determine NEWS suffix
  500. 5000  PRINT USING U5$;ABS(Z1);:PRINT Z1$;" ";
  501. 5010  PRINT USING U5$;ABS(Z2);:PRINT Z2$;"  ";A$(Z,1);
  502. 5020  IF A$(Z,2)=""THEN 5030 ELSE PRINT ", ";A$(Z,2);
  503. 5030  IF A$(Z+1,1)=""THEN 5090
  504. 5040  PRINT TAB(41);USING U5$;ABS(Z3);:PRINT Z3$;" ";
  505. 5050  PRINT USING U5$;ABS(Z4);:PRINT Z4$;"  ";A$(Z+1,1);
  506. 5060  IF A$(Z+1,2)=""THEN 5070 ELSE PRINT ", ";A$(Z+1,2);
  507. 5070  IF LIN<24 THEN PRINT "":GOTO 5090
  508. 5080  GOSUB 7170:LIN=0:CLS
  509. 5090  NEXT Z
  510. 5100  '
  511. 5110  IF LIN>21 THEN GOSUB 7170:GOTO 5120 ELSE 5130
  512. 5120  CLS
  513. 5130  PRINT UL$;
  514. 5140  PRINT N;"listings as of ";DATE$
  515. 5150  GOSUB 7170
  516. 5160  COLOR 7,0:CLS:GOTO 4230  'save data
  517. 5170  '
  518. 5180  '.....determine NSEW suffix
  519. 5190  E$=CHR$(248)
  520. 5200  Z1=VAL(A$(Z,3)):IF Z1<0 THEN Z1$=E$+"S"ELSE Z1$=E$+"N"
  521. 5210  Z2=VAL(A$(Z,4)):IF Z2<0 THEN Z2$=E$+"W"ELSE Z2$=E$+"E"
  522. 5220  Z3=VAL(A$(Z+1,3)):IF Z3<0 THEN Z3$=E$+"S"ELSE Z3$=E$+"N"
  523. 5230  Z4=VAL(A$(Z+1,4)):IF Z4<0 THEN Z4$=E$+"W"ELSE Z4$=E$+"E"
  524. 5240  RETURN
  525. 5250  '
  526. 5260  '.....menu return
  527. 5270  'CLS
  528. 5280  PRINT:PRINT " Nothing starting with ";I$;" on file...."
  529. 5290  PRINT:PRINT " Press SPACE BAR to return to Menu
  530. 5300  Z$=INKEY$:IF Z$=" "THEN CLS:GOTO 4060
  531. 5310  GOTO 5300
  532. 5320  '
  533. 5330  '.....find location
  534. 5340  LOCATE 1
  535. 5350  PRINT " Press number in ( ) to enter what you know about sought location:"
  536. 5360  PRINT UL$;
  537. 5370  PRINT " (1) City, Town, Province, State or Country"
  538. 5380  PRINT " (2) Latitude and Longitude"
  539. 5390  Z$=INKEY$
  540. 5400  IF Z$="1"THEN CLS:GOTO 5730
  541. 5410  IF Z$="2"THEN CLS:GOTO 5440
  542. 5420  GOTO 5390
  543. 5430  '
  544. 5440  '.....find latitude & longitude
  545. 5450  GOSUB 4430:LA$=I$:GOSUB 4450:LO$=I$
  546. 5460  LAT=VAL(LA$):LON=VAL(LO$)         'sought co-ordinates
  547. 5470  CLS:LOCATE 24,18
  548. 5480  PRINT " SEARCHING for Latitude ";USING "+##.#";LAT;
  549. 5490  PRINT ", Longitude ";USING "+###.#";LON
  550. 5500  D=PI   'distance angle
  551. 5510  A=VAL(LA$)*PI/180
  552. 5520  L1=VAL(LO$)*PI/180
  553. 5530  FOR X=1 TO N
  554. 5540   B=VAL(A$(X,3)):L2=VAL(A$(X,4))
  555. 5550   IF A=B AND L1=L2 THEN 5440
  556. 5560   B=B*PI/180:L2=L2*PI/180
  557. 5570   Z=SIN(A)*SIN(B)+COS(A)*COS(B)*COS(ABS(L1-L2)):GOSUB 6810
  558. 5580   IF RC<D THEN D=RC:LL=X
  559. 5590  NEXT X
  560. 5600  '
  561. 5610  CLS:Z=LL
  562. 5620  IF LAT>0 THEN LAT$=E$+"N"ELSE LAT$=E$+"S"
  563. 5630  IF LON>0 THEN LON$=E$+"E"ELSE LON$=E$+"W"
  564. 5640  DIST=D*180/PI*40000/360:D$="kilometers"
  565. 5650  DIST=INT(DIST*10+0.5)/10             'round-off to 1 decimal place
  566. 5660  PRINT " Target location is ";USING U1$;ABS(LAT);:PRINT LAT$;",";
  567. 5670  PRINT USING U2$;ABS(LON);:PRINT LON$
  568. 5680  IF DIST=0 THEN 5700
  569. 5690  PRINT " Nearest location on file,";DIST;D$;" from target location, is:"
  570. 5700  PRINT UL$;
  571. 5710  GOSUB 6310:GOTO 6140
  572. 5720  '
  573. 5730  '.....find name
  574. 5740  LOCATE 1
  575. 5750  INPUT" ENTER first few characters of Town, State, Country, Prefix, etc.";I$
  576. 5760  GOSUB 4320         'capitalize
  577. 5770  CLS
  578. 5780  LOCATE 24,35:PRINT " SEARCHING...";
  579. 5790  LOCATE 1
  580. 5800  L=LEN(I$):F=0
  581. 5810  FOR Z=1 TO N
  582. 5820  FOR Y=1 TO 2:IF LEFT$(A$(Z,Y),L)<>I$ THEN 5900
  583. 5830  F=F+1
  584. 5840  F$(F,2)=STR$(Z)
  585. 5850  F$(F,1)=A$(Z,1)
  586. 5860  IF A$(Z,2)<>""THEN F$(F,1)=F$(F,1)+", "+A$(Z,2)
  587. 5870  IF F$(F,1)+F$(F,2)=F$(F-1,1)+F$(F-1,2)THEN F=F-1:GOTO 5910
  588. 5880  IF F<27 THEN 5900
  589. 5890  CLS:PRINT" LONG LIST - Please enter more letters !":GOTO 5750
  590. 5900  NEXT Y
  591. 5910  NEXT Z:IF F=0 THEN 5260
  592. 5920  CLS:IF F=1 THEN Z=VAL(F$(F,2)):GOTO 6130
  593. 5930  '
  594. 5940  PRINT " Location names starting with ";
  595. 5950  COLOR 0,7:PRINT " ";I$;" ":COLOR 7,0
  596. 5960  PRINT UL$;
  597. 5970  CF=CINT(F/2)
  598. 5980  FOR Z=1 TO CINT(F/2)
  599. 5990  PRINT " (";CHR$(96+Z);")  ";F$(Z,1);TAB(41);
  600. 6000  PRINT "(";CHR$(96+CF+Z);")  ";F$(Z+CF,1)
  601. 6010  NEXT Z
  602. 6020  IF F/2<>INT(F/2)THEN LOCATE CSRLIN-1,41:PRINT STRING$(39,32)
  603. 6030  PRINT UL$;
  604. 6040  LIN=CSRLIN
  605. 6050  PRINT " Press letter in ( ) to select listing or <0> to return to menu"
  606. 6060  Z$=INKEY$:IF Z$=""THEN 6060
  607. 6070  IF Z$="0"THEN 4030
  608. 6080  Z=ASC(Z$)-96
  609. 6090  IF Z>=1 AND Z<=F THEN Y=Z:Z=VAL(F$(Y,2)):CLS:GOTO 6130
  610. 6100  GOTO 6060
  611. 6110  '
  612. 6120  '.....display listing
  613. 6130  GOSUB 6310
  614. 6140  PRINT " Press number in ( ) for next step:":PRINT UL$;
  615. 6150  IF FAR$=""THEN 6180
  616. 6160  PRINT " (1) SELECT this listing for Great Circle calculation
  617. 6170  IF FAR$<>""THEN 6200
  618. 6180  PRINT " (2) EDIT Listing
  619. 6190  PRINT " (3) DELETE Listing
  620. 6200  PRINT UL$;
  621. 6210  PRINT " (0) RETURN to menu
  622. 6220  Z$=INKEY$
  623. 6230  IF FAR$=""THEN 6260
  624. 6240  IF Z$="1"THEN CLS:GOTO 6430
  625. 6250  IF FAR$<>""THEN 6280
  626. 6260  IF Z$="2"THEN CLS:GOTO 6510
  627. 6270  IF Z$="3"THEN BEEP:PRINT:GOTO 6680
  628. 6280  IF Z$="0"THEN 4030
  629. 6290  GOTO 6220
  630. 6300  '
  631. 6310  PRINT" line 1: ";A$(Z,1)
  632. 6320  PRINT" line 2: ";A$(Z,2)
  633. 6330  B=VAL(A$(Z,3)):IF B<0 THEN B$=E$+"S"ELSE B$=E$+"N"
  634. 6340  PRINT" line 3: ";
  635. 6350  PRINT"Lat  ";USING "###.###";ABS(B);:PRINT B$
  636. 6360  PRINT" line 4: ";
  637. 6370  B=VAL(A$(Z,4)):IF B<0 THEN B$=E$+"W"ELSE B$=E$+"E"
  638. 6380  PRINT"Long ";USING "###.###";ABS(B);:PRINT B$
  639. 6390  PRINT"         Solar Time Zone UTC";USING "+##";B/15
  640. 6400  PRINT UL$;
  641. 6410  RETURN
  642. 6420  '
  643. 6430  '.....assign variables for Great Circle calculations
  644. 6440  P$(POSN)=A$(Z,1)
  645. 6450  IF A$(Z,2)<>""THEN P$(POSN)=P$(POSN)+", "+A$(Z,2)
  646. 6460  LA(POSN)=VAL(A$(Z,3))
  647. 6470  LO(POSN)=VAL(A$(Z,4))
  648. 6480  GOTO 10
  649. 6490  '
  650. 6500  '.....change listing
  651. 6510  GOSUB 6310:PRINT " Press number in ( ) to change listing:":PRINT UL$;
  652. 6520  FOR Y=1 TO 4:PRINT " (";Y;")  Change Line";Y:NEXT Y
  653. 6530  PRINT " ( 5 )  O.K. as is
  654. 6540  Z$=INKEY$:Q=VAL(Z$):IF Q<1 OR Q>5 THEN 6650
  655. 6550  IF Z$="1"THEN GOSUB 4390:A$(Z,1)=I$:GOSUB 6610:CLS:GOTO 6510
  656. 6560  IF Z$="2"THEN GOSUB 4410:A$(Z,2)=I$:GOSUB 6610:CLS:GOTO 6510
  657. 6570  IF Z$="3"THEN GOSUB 4430:A$(Z,3)=I$:CLS:GOTO 6510
  658. 6580  IF Z$="4"THEN GOSUB 4450:A$(Z,4)=I$:CLS:GOTO 6510
  659. 6590  IF Z$="5"THEN CLS:GOTO 4230
  660. 6600  '
  661. 6610  IF LEN(A$(Z,1))+LEN(A$(Z,2))<21 THEN 6660
  662. 6620  BEEP:PRINT " TOO LONG! Please abbreviate lines 1 and/or 2...."
  663. 6630  PRINT " Press any key to continue.........."
  664. 6640  IF INKEY$=""THEN 6640 ELSE CLS:GOTO 6500
  665. 6650  GOTO 6540
  666. 6660  RETURN
  667. 6670  '
  668. 6680  '.....delete listing
  669. 6690  BEEP:COLOR 0,7
  670. 6700  PRINT " Are you SURE you want to delete this file?   (y/n) "
  671. 6710  COLOR 7,0
  672. 6720  Z$=INKEY$
  673. 6730  IF Z$="y"THEN 6760
  674. 6740  IF Z$="n"THEN CLS:GOTO 6120
  675. 6750  GOTO 6720
  676. 6760  CLS:PRINT " LISTING DELETED. File being re-sorted.....please wait...."
  677. 6770  FOR X=Z TO N:LOCATE 12,39:PRINT N-X
  678. 6780  FOR Y=1 TO 4
  679. 6790  A$(X,Y)=A$(X+1,Y):NEXT Y:NEXT X:N=N-1:GOTO 4230   'save data
  680. 6800  '
  681. 6810  '.....ACS, ASN                  'GOSUB HERE TO GET ASN/ACS
  682. 6820  IF Z=0 THEN RC=PI/2:GOTO 6850   'Z=VALUE FROM PROGRAM
  683. 6830  IF Z=1 THEN RC=0:GOTO 6850
  684. 6840  RC=-ATN(Z/SQR(1-Z^2))+PI/2      'RC=ANGLE IN RADIANS IF Z=COS
  685. 6850  RS=PI/2-RC                      'RS=ANGLE IN RADIANS IF Z=SIN
  686. 6860  RETURN
  687. 6870  '
  688. 6880  '....clear memories
  689. 6890  FOR M=1 TO 2
  690. 6900  P$(M)="":LA(M)=0:LO(M)=0
  691. 6910  NEXT M
  692. 6920  POSN=0:FAR$=""
  693. 6930  Z$="":QX=0:QY=0:FF=0
  694. 6940  GOTO 380
  695. 6950  '
  696. 6960  '.....preface
  697. 6970  T=7
  698. 6980  PRINT TAB(T);
  699. 6990  PRINT "This program calculates Great Circle paths, bearings and distances"
  700. 7000  PRINT TAB(T);
  701. 7010  PRINT "between any two points on earth, including those on or very close"
  702. 7020  PRINT TAB(T);
  703. 7030  PRINT "to the same meridian, the equator, or the earth's poles. Several"
  704. 7040  PRINT TAB(T);
  705. 7050  PRINT "intermediate points are also calculated as an aid in plotting the"
  706. 7060  PRINT TAB(T);
  707. 7070  PRINT "path on a flat chart or map drawn in any projection. Solar time"
  708. 7080  PRINT TAB(T);
  709. 7090  PRINT "difference between the two end points is also shown."
  710. 7100  PRINT
  711. 7110  PRINT TAB(T);
  712. 7120  PRINT "Also included is a data base of over 500 locations that can be"
  713. 7130  PRINT TAB(T);
  714. 7140  PRINT "inserted into the program, and which can be edited by the user."
  715. 7150  RETURN
  716. 7160  '
  717. 7170  'HARDCOPY
  718. 7180  GOSUB 7290:LOCATE 25,2:COLOR 14,6
  719. 7190  PRINT " Press 1 to print screen, 2 to print screen & ";
  720. 7200  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  721. 7210  Z$=INKEY$:IF Z$="3"THEN GOSUB 7290:RETURN
  722. 7220  IF Z$="1"OR Z$="2"THEN GOSUB 7290:GOTO 7240
  723. 7230  GOTO 7210
  724. 7240  FOR QX=1 TO 24:FOR QY=1 TO 80
  725. 7250  LPRINT CHR$(SCREEN(QX,QY));
  726. 7260  NEXT QY:NEXT QX
  727. 7270  IF Z$="2"THEN LPRINT CHR$(12)
  728. 7280  GOTO 7180
  729. 7290  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  730.